;Inteligencia Artificial II
;Practica 1 - Familia
;Alfonso Sendra Gamero

(dribble-on practica_1_traza.txt)

(clear)

;plantilla para persona
(deftemplate persona
	(multislot nombre)
	(slot sexo (allowed-values hombre mujer))
	(slot padre)
	(slot madre)
	(multislot hermanos)
	(slot pareja)
	(multislot hijos)
	(multislot sobrinos)
	(multislot primos)
	(multislot tios)
	(multislot abuelos (cardinality 0 2))
	(multislot nietos)
	(multislot bisabuelos)
)

;hechos iniciales
(deffacts initial-fact
	(persona (nombre Fernando) (sexo hombre) (pareja Isabel) (hijos Catalina Juan Juana))
	(persona (nombre Isabel) (sexo mujer) (pareja Fernando) (hijos Catalina Juan Juana))
	(persona (nombre Catalina) (sexo mujer) (padre Fernando) (madre Isabel) (pareja Enrique) (hijos Maria) (hermanos Juan Juana))
	(persona (nombre Maria) (sexo mujer) (padre Enrique) (madre Catalina))
	(persona (nombre Juan) (sexo hombre) (padre Fernando) (madre Isabel) (pareja Margarita) (hermanos Catalina Juana))
	(persona (nombre Juana) (sexo mujer) (padre Fernando) (madre Isabel) (pareja Felipe) (hijos Carlos Leonor) (hermanos Juan Catalina))
	(persona (nombre Carlos) (sexo hombre) (padre Felipe) (madre Juana) (hermanos Leonor))
	(persona (nombre Leonor) (sexo mujer) (padre Felipe) (madre Juana) (pareja Fran) (hijos Susana) (hermanos Carlos))
	(persona (nombre Susana) (sexo mujer) (padre Fran) (madre Leonor))
)
	
(reset)

;regla para calcular los tios/sobrinos 
(defrule tios_sobrinos
	?v1 <- (persona (nombre ?sobrino) (tios $?tios))
	(persona (hijos $?hijos) (hermanos $?hermanos))
	(test (member$ ?sobrino $?hijos))
	?v2 <- (persona (nombre ?tio) (sobrinos $?sobrinos))
	(test (member$ ?tio $?hermanos))
	(test (not (member$ ?tio $?tios)))
	=>	(printout t "un tio de " ?sobrino " es " ?tio crlf)
		(modify ?v1 (tios $?tios ?tio))
		(modify ?v2 (sobrinos $?sobrinos ?sobrino))
)

;regla para calcular los primos
(defrule primos
	?v1 <- (persona (nombre ?nombre) (tios $?tios) (primos $?primos))
	(persona (nombre ?tio) (hijos $?hijos))
	(test (member$ ?tio $?tios))
	(persona (nombre ?primo))
	(test (member$ ?primo $?hijos))
	(test (not (member ?primo $?primos)))
	=>	(printout t "un primo de " ?nombre " es " ?primo crlf)
		(modify ?v1 (primos $?primos ?primo))
)

;regla para calcular los abuelos/nietos
(defrule abuelos_nietos
	?v1 <- (persona (nombre ?nieto) (abuelos $?abuelos))
	(persona (nombre ?padre) (hijos $?hijos))
	(test (member$ ?nieto $?hijos))
	?v2 <- (persona (nombre ?abuelo) (hijos $?hijos2) (nietos $?nietos))
	(test (member$ ?padre $?hijos2))
	(test (not (member$ ?abuelo $?abuelos)))
	=>	(printout t "un abuelo de " ?nieto " es " ?abuelo crlf)
		(modify ?v1 (abuelos $?abuelos ?abuelo))
		(modify ?v2 (nietos $?nietos ?nieto))
)

;regla para calcular los bisabuelos
(defrule bisabuelos
	?v1 <- (persona (nombre ?biznieto) (abuelos $?abuelos) (bisabuelos $?bisabuelos))
	(persona (nombre ?abuelo))
	(test (member$ ?abuelo $?abuelos))
	(persona (nombre ?bisabuelo) (hijos $?hijos))
	(test (member$ ?abuelo $?hijos))
	(test (not (member ?bisabuelo $?bisabuelos)))
	=>	(printout t "un bisabuelo de " ?biznieto " es " ?bisabuelo crlf)
		(modify ?v1 (bisabuelos $?bisabuelos ?bisabuelo))
)

;regla para determinar los hermanos
;la explico paso a paso
(defrule XXX
	(persona (nombre ?x) (hijos $?hijos))		;Precondicion 1: para todos los miembros de la familia
	?f<-(persona (nombre ?y) (madre ?x) (hermanos $?h))		;Precondicion 2: para todos los hijos que tienen una madre
	(test (not (subsetp $?h $?hijos)))			;Tengo que introducir este test porque si no la regla entra en un bucle 
												;infinito al reevaluarse la regla cada vez que se modifica el hecho
	
	=>
	(bind ?pos (member$ ?y $?hijos))			;Guardo en $pos la posicion del hijo $y dentro del campo $?hijos de su madre
	;(bind $?lista (delete$ $?hijos ?pos ?pos))  ;Guardo en $?lista el resultado de quitar el elemento ?pos, que se corresponde
												;con ?y, de $?hijos. Obtengo la lista de hermanos de ?y
	(bind $?lista (delete-member$ $?hijos ?y))	;modificacion para utilizar la funcion delete-member
	(modify ?f (hermanos $?lista))				;Modifico el hecho del hijo ?y con su lista de hermanos
	(printout t "lista: " ?y " " $?lista crlf)
);; rule XXX

;regla para determinar el sexo de los primos de una persona
(defrule sexo_primo
	(persona (nombre ?nombre) (primos $?primos))
	(test (> (length$ $?primos) 0))
	=>
	(printout t "la lista de primos de " ?nombre " es :" crlf)
	(progn$ (?field  $?primos)
		(assert (imprime_sexo ?field)))
)

;regla para imprimir el sexo de los primos
(defrule imprime
	?v1 <- (imprime_sexo ?nombre)
	(persona (nombre ?nombre) (sexo ?sexo))
	=>
	(printout t ?nombre " que es " ?sexo crlf)
	(retract ?v1)
)

(run)

(dribble-off)
